home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / PictElems.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1994-12-21  |  5.5 KB  |  157 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 21 Dec 94
  5. Syntax10i.Scn.Fnt
  6. Syntax10b.Scn.Fnt
  7. MODULE PictElems;    (* HM 
  8. IMPORT Sys, Display, Files, Fonts, Input, Printer, Texts, TextFrames, TextPrinter, Oberon, Out, SYSTEM;
  9. (*--- pictures*)
  10.     Ptr = LONGINT;
  11.     Handle = LONGINT;
  12.     Picture = RECORD [Sys.align68K]
  13.         picSize: INTEGER;
  14.         picFrame: Sys.Rect;
  15.         data: ARRAY 100000 OF LONGINT (*picture data: not allocated in full size*)
  16.     END;
  17.     PicHandle = POINTER TO RECORD [Sys.align68K]
  18.         p: POINTER TO Picture
  19.     END;
  20.     DrawPicture: PROCEDURE (myPicture: Handle; dstRect: Sys.Rect);
  21.     KillPicture: PROCEDURE (myPicture: Handle);
  22. (*--- scrap manager*)
  23. CONST
  24.     PICT = 50494354H; (*"PICT"*)
  25.     GetScrap: PROCEDURE (handle, type: LONGINT; VAR offset: LONGINT): LONGINT;
  26.     PutScrap: PROCEDURE (length, theType: LONGINT; src: Ptr): LONGINT;
  27.     ZeroScrap: PROCEDURE (): LONGINT;
  28. (*--- element*)
  29. CONST
  30.     pixel = LONG(TextFrames.Unit); ppixel = LONG(TextPrinter.Unit);
  31.     left = 2; middle = 1; right = 0;
  32.     Elem = POINTER TO ElemDesc;
  33.     ElemDesc = RECORD (Texts.ElemDesc)
  34.         pic: PicHandle;
  35.         len: LONGINT
  36.     END;
  37. PROCEDURE CopyElem (e: Elem);
  38.     VAR err: LONGINT;
  39. BEGIN
  40.     err := ZeroScrap();
  41.     err := PutScrap(e.len, PICT, SYSTEM.VAL(Ptr, e.pic.p));
  42.     ASSERT(err = 0)
  43. END CopyElem;
  44. PROCEDURE PasteElem (e: Elem);
  45.     VAR dummy, h, pos: LONGINT; ph: PicHandle; t: Texts.Text; r: Sys.Rect;
  46. BEGIN
  47.     h := Sys.NewHandle(0);
  48.     e.len := GetScrap(h, PICT, dummy);
  49.     IF e.len > 0 THEN
  50.         ph := SYSTEM.VAL(PicHandle, h);
  51.         NEW(e.pic); SYSTEM.NEW(e.pic.p, e.len);
  52.         SYSTEM.MOVE(SYSTEM.ADR(ph.p^), SYSTEM.ADR(e.pic.p^), e.len);
  53.         r := e.pic.p.picFrame; KillPicture(h);
  54.         e.W := (r.right - r.left) * pixel; e.H := (r.bottom - r.top) * pixel;
  55.         t := Texts.ElemBase(e);
  56.         IF t # NIL THEN
  57.             pos := Texts.ElemPos(e);
  58.             TextFrames.NotifyDisplay(t, Texts.replace, pos, pos + 1)
  59.         END
  60.     ELSE Out.String("-- no picture in clipboard$")
  61. END PasteElem;
  62. (* GetDsr should not be necessary if the error in TextPrinter is corrected *)
  63. PROCEDURE GetDsr (f: Display.Frame; pos: LONGINT; fnt: Fonts.Font; VAR dsr: INTEGER);
  64.     VAR p: TextFrames.Parc; beg: LONGINT;
  65. BEGIN
  66.     IF f = NIL THEN
  67.         IF fnt = NIL THEN dsr := 0 ELSE dsr := - fnt.minY END
  68.     ELSE
  69.         TextFrames.ParcBefore(f(TextFrames.Frame).text, pos, p, beg);
  70.         dsr := SHORT(p.dsr DIV TextFrames.Unit)
  71. END GetDsr;
  72. PROCEDURE Handler* (e: Texts.Elem; VAR m: Texts.ElemMsg);
  73.     VAR e1: Elem; r: Sys.Rect; x, y, dsr: INTEGER; keys: SET;
  74. BEGIN
  75.     WITH e: Elem DO
  76.         WITH
  77.            m: TextFrames.DisplayMsg DO
  78.             IF ~m.prepare THEN
  79.                 r.left := m.X0; r.right := r.left + SHORT(e.W DIV pixel);
  80.                 r.bottom := Display.Height - m.Y0; r.top := r.bottom - SHORT(e.H DIV pixel);
  81.                 DrawPicture(SYSTEM.VAL(Handle, e.pic), r)
  82.             END
  83.         | m: TextPrinter.PrintMsg DO
  84.             IF ~m.prepare THEN
  85.                 GetDsr(NIL, m.pos, m.fnt, dsr);
  86.                 r.left := m.X0; r.right := r.left + SHORT(e.W DIV ppixel);
  87.                 r.bottom := Printer.PageHeight - m.Y0 - SHORT(dsr*pixel DIV ppixel);
  88.                 r.top := r.bottom - SHORT(e.H DIV ppixel);
  89.                 DrawPicture(SYSTEM.VAL(Handle, e.pic), r)
  90.             END
  91.         | m: Texts.IdentifyMsg DO
  92.             m.mod := "PictElems"; m.proc := "Alloc"
  93.         | m: Texts.FileMsg DO
  94.             IF m.id = Texts.load THEN
  95.                 Files.ReadNum(m.r, e.len);
  96.                 NEW(e.pic); SYSTEM.NEW(e.pic.p, e.len); Files.ReadBytes(m.r, e.pic.p^, e.len);
  97.                 r := e.pic.p.picFrame;
  98.                 e.W := (r.right - r.left) * pixel; e.H := (r.bottom - r.top) * pixel
  99.             ELSIF m.id = Texts.store THEN
  100.                 Files.WriteNum(m.r, e.len); Files.WriteBytes(m.r, e.pic.p^, e.len)
  101.             END
  102.         | m: Texts.CopyMsg DO
  103.             NEW(e1); Texts.CopyElem(e, e1); e1.len := e.len; e1.pic := e.pic; m.e := e1
  104.         | m: TextFrames.TrackMsg DO
  105.             IF middle IN m.keys THEN
  106.                 REPEAT Input.Mouse(keys, x, y); m.keys := m.keys + keys;
  107.                     Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  108.                 UNTIL keys = {};
  109.                 IF m.keys = {middle, right} THEN CopyElem(e)
  110.                 ELSIF m.keys = {middle, left} THEN PasteElem(e)
  111.                 END
  112.             END
  113.         ELSE
  114.         END
  115. END Handler;
  116. PROCEDURE Alloc*;
  117.     VAR e: Elem;
  118. BEGIN NEW(e); e.handle := Handler; Texts.new := e
  119. END Alloc;
  120. PROCEDURE Insert*;
  121.     VAR e: Elem; insert: TextFrames.InsertElemMsg;
  122. BEGIN
  123.     NEW(e); e.handle := Handler; PasteElem(e);
  124.     IF e.len > 0 THEN
  125.         insert.e := e; Oberon.FocusViewer.handle(Oberon.FocusViewer, insert)
  126. END Insert;
  127. PROCEDURE Copy*;
  128.     VAR t: Texts.Text; beg, end, time: LONGINT; r: Texts.Reader; e: Texts.Elem;
  129. BEGIN
  130.     Oberon.GetSelection(t, beg, end, time);
  131.     IF time >= 0 THEN
  132.         Texts.OpenReader(r, t, beg);
  133.         REPEAT Texts.ReadElem(r) UNTIL r.eot OR (Texts.Pos(r) > end) OR (r.elem IS Elem);
  134.         IF ~r.eot & (Texts.Pos(r) <= end) THEN CopyElem(r.elem(Elem)) END
  135.     END;
  136. END Copy;
  137. PROCEDURE Paste*;
  138.     VAR t: Texts.Text; beg, end, time: LONGINT; r: Texts.Reader; e: Texts.Elem;
  139. BEGIN
  140.     Oberon.GetSelection(t, beg, end, time);
  141.     IF time >= 0 THEN
  142.         Texts.OpenReader(r, t, beg);
  143.         REPEAT Texts.ReadElem(r) UNTIL r.eot OR (Texts.Pos(r) > end) OR (r.elem IS Elem);
  144.         IF ~r.eot & (Texts.Pos(r) <= end) THEN PasteElem(r.elem(Elem)) END
  145.     END;
  146. END Paste;
  147. BEGIN
  148.     Sys.Assign("GetScrap", SYSTEM.ADR(GetScrap));
  149.     Sys.Assign("PutScrap", SYSTEM.ADR(PutScrap));
  150.     Sys.Assign("ZeroScrap", SYSTEM.ADR(ZeroScrap));
  151.     Sys.Assign("DrawPicture", SYSTEM.ADR(DrawPicture));
  152.     Sys.Assign("KillPicture", SYSTEM.ADR(KillPicture));
  153. END PictElems.
  154. PictElems.Insert
  155. System.Free PictElems ~
  156. System.DeleteFiles xxx ~
  157.